home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / SYS_TOOL / MULTI020 / MPFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-07  |  2KB  |  91 lines
  1. unit mpfile;
  2. { File in- and output clients for MPipes }
  3. interface
  4. uses multi, mpipes;
  5.  
  6. procedure AttachFileInTask(const fname : string; m : pPipe);
  7. { Start client which feeds data from the file into the pipe. }
  8.  
  9. procedure AttachFileOutTask(const fname : string; m : pPipe);
  10. { Start client which feeds data from the pipe to the file. }
  11.  
  12. implementation
  13.  
  14. type
  15.   pipeinforec = record
  16.     p : pPipe;
  17.     f : file;
  18.   end;
  19.  
  20. procedure FileInTask(var m); far;
  21. var
  22.   pipeinfo : pipeinforec absolute m;
  23.   w : word;
  24.   fbuf : array[1..1024] of char;
  25. begin
  26.   t^.hasexit := true;
  27.   pipeinfo.p^.NewInputTask;
  28.   repeat
  29.     blockread(pipeinfo.f,fbuf,1024,w);
  30.     if pipeinfo.p^.PutBin(fbuf,w) then break;
  31.     if w < 1024 then break;
  32.   until false;
  33.   close(pipeinfo.f);
  34.   pipeinfo.p^.NoMoreInput;
  35.   freemem(@m,sizeof(pipeinforec))
  36. end;
  37.  
  38. procedure FileOutTask(var m); far;
  39. var
  40.   pipeinfo : pipeinforec absolute m;
  41.   w : word;
  42.   fbuf : array[1..1024] of char;
  43. begin
  44.   t^.hasexit := true;
  45.   pipeinfo.p^.NewOutputTask;
  46.   w := 0;
  47.   repeat
  48.     fbuf[w] := pipeinfo.p^.Get;
  49.     if t^.Poisoned then break;
  50.     inc(w);
  51.     if w = 1024 then begin
  52.       blockwrite(pipeinfo.f,fbuf,1024,w);
  53.       if w < 1024 then break;
  54.       w := 0
  55.     end;
  56.   until false;
  57.   blockwrite(pipeinfo.f,fbuf,w,w);
  58.   close(pipeinfo.f);
  59.   pipeinfo.p^.NoMoreOutput;
  60.   freemem(@m,sizeof(pipeinforec))
  61. end;
  62.  
  63. procedure AttachFileInTask(const fname : string; m : pPipe);
  64. var p : ^pipeinforec;
  65. begin
  66.   new(p);
  67.   p^.p := m;
  68.   assign(p^.f,fname); {$I-} reset(p^.f,1); {$I+}
  69.   if ioresult = 0 then begin
  70.     Fork(FileInTask,3*1024,p^
  71.     {$IFDEF DEBUG} ,'FileIn '+fname {$ENDIF});
  72.   end else
  73.     dispose(p)
  74. end;
  75.  
  76. procedure AttachFileOutTask(const fname : string; m : pPipe);
  77. var p : ^pipeinforec;
  78. begin
  79.   new(p);
  80.   p^.p := m;
  81.   assign(p^.f,fname); {$I-} rewrite(p^.f,1); {$I+}
  82.   if ioresult = 0 then begin
  83.     Fork(FileInTask,3*1024,p^
  84.     {$IFDEF DEBUG} ,'FileOut '+fname {$ENDIF});
  85.   end else
  86.     dispose(p)
  87. end;
  88.  
  89. end.
  90.  
  91.